(* A hash-queue is a combination of a queue and a hashtable that
 * supports constant-time lookup and removal of queue elements in addition to
 * the usual queue operations (enqueue, dequeue).  The queue elements are key-value
 * pairs.  The hashtable has one entry for each element of the queue. *)

type key_value 'k 'v = {
  k: 'k;
  v: mutable 'v;
};

type dll_node 'k 'v = Dllist.node_t (key_value 'k 'v);

type t 'k 'v = 
  {
    queue : mutable (option (dll_node 'k 'v));
    table : Hashtbl.t 'k (dll_node 'k 'v);
  };

value empty () = {queue=None; table=Hashtbl.create 3};
value is_empty t = t.queue = None;

value push t k v =
  let n = 
    match t.queue with
    [ None -> 
      let n = Dllist.create {k=k;v=v} in
      (
        t.queue := Some n;
        n
      )
    | Some queue -> Dllist.append (Dllist.prev queue) {k=k;v=v}
    ]
  in
  Hashtbl.add t.table k n;

exception Empty;

value pop t =
  match t.queue with
  [ None -> raise Empty
  | Some queue ->
    let n = Dllist.get queue in
    (
      Hashtbl.remove t.table n.k;
      if Hashtbl.length t.table = 0
      then t.queue := None
      else t.queue := Some (Dllist.drop queue);
      n.v;
    )
  ];

exception No_such_key;

value mem t k = Hashtbl.mem t.table k;

value remove t k =
  match t.queue with
  [ None -> raise Empty
  | Some queue ->
    try
      let n = Hashtbl.find t.table k in
      (
        Hashtbl.remove t.table k;
        if Hashtbl.length t.table = 0
        then
          t.queue := None
        else 
          if n == queue 
          then t.queue := Some (Dllist.drop n)
          else Dllist.remove n
      )
    with [ Not_found -> raise No_such_key ]
  ];

value remove_all t k = 
  match t.queue with
  [ None -> raise Empty
  | Some queue -> 
    try
      let ns = MHashtbl.pop_all t.table k in
      if MHashtbl.is_empty t.table
      then t.queue := None
      else 
        List.iter begin fun n ->
          if n == queue
          then t.queue := Some (Dllist.drop n)
          else Dllist.remove n
        end ns
    with [ Not_found -> () ]
  ];


value iter ~f t = 
  match t.queue with
  [ None -> ()
  | Some queue ->
      Dllist.iter (fun n -> f n.v) queue
  ];

value clear t = 
(
  t.queue := None;
  Hashtbl.clear t.table;
);


value to_list t = 
  match t.queue with
  [ None -> []
  | Some queue -> List.map (fun kv -> kv.v ) (Dllist.to_list queue)
  ];

(*
  let invariant t =
    assert (Doubly_linked.length t.queue = Table.length t.table);
    (* Look at each element in the queue, checking:
     *   - every element in the queue is in the hash table
     *   - there are no duplicate keys
     *)
    let keys = Table.create (Table.length t.table) in
    Doubly_linked.iter t.queue ~f:(fun kv ->
      let key = kv.key in
      match Table.find t.table key with
      | None -> assert false
      | Some _ ->
          assert (not (Table.mem keys key));
          Table.add keys ~key ~data:());
  ;;

value length t = Hashtbl.length t.table;

value is_empty t = 0 = length t;

let find_opt t k = 
  match Hashtbl.find t.table k with
  | None -> None
  | Some elt -> Some (Elt.value elt).value

  let mem t k = Table.mem t.table k

  type 'a container = 'a t

  let to_list t = List.map (Doubly_linked.to_list t.queue) ~f:Key_value.value

  let to_array t = Array.map (Doubly_linked.to_array t.queue) ~f:Key_value.value

  let for_all t ~f = Doubly_linked.for_all t.queue ~f:(fun kv -> f kv.value)

  let exists t ~f = Doubly_linked.for_all t.queue ~f:(fun kv -> f kv.value)

  let find t ~f =
    Option.map (Doubly_linked.find t.queue ~f:(fun kv -> f kv.value))
      ~f:Key_value.value
  ;;

  let enqueue t key value =
    if Table.mem t.table key then
      `Key_already_present
    else begin
      let elt =
        Doubly_linked.insert_last t.queue
          { Key_value.key = key; value = value; }
      in
      Table.add t.table ~key ~data:elt;
      `Ok
    end

  let dequeue_with_key t =
    Option.map (Doubly_linked.remove_first t.queue) ~f:(fun kv ->
      Table.remove t.table kv.key;
      (kv.key, kv.value))
  ;;
                                                  
  let dequeue t = 
    match dequeue_with_key t with
    | None -> None
    | Some (_, v) -> Some v

  let iter_keys t ~f =
    Doubly_linked.iter t.queue ~f:(fun kv -> f ~key:kv.key ~data:kv.value)
  ;;

  let iter t ~f = iter_keys t ~f:(fun ~key:_ ~data -> f data)

  let fold_keys t ~init ~f =
    Doubly_linked.fold t.queue ~init ~f:(fun ac kv ->
      (f ac ~key:kv.key ~data:kv.value))
  ;;

  let fold t ~init ~f = fold_keys t ~init ~f:(fun ac ~key:_ ~data -> f ac data)

  let dequeue_all t ~f =
    let rec loop () = 
      match dequeue t with
      | None -> ()
      | Some v -> f v; loop ()
    in
    loop ()

  let remove t k = 
    match Table.find t.table k with
    | None -> `No_such_key
    | Some elt ->
        Doubly_linked.remove t.queue elt;
        Table.remove t.table (Elt.value elt).key;
        `Ok
  ;;

  let replace t k v = 
    match Table.find t.table k with
    | None -> `No_such_key
    | Some elt -> (Elt.value elt).value <- v; `Ok
  ;;

end
*)
